home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PAS_0793
/
SERIAL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-08-01
|
6KB
|
169 lines
(*─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg : 274 of 284
From : Ethan Brodsky 1:121/8.0 06 Jul 93 22:14
To : Ben Curtis
Subj : Serial number of disk
────────────────────────────────────────────────────────────────────────────────
> * Ethan Brodsky was talking all about Serial Number of disk to Mike
> Copeland *
>
> EB> Sorry, my time ran out between messages. Here is the rest of
> the EB> serial number program. My comm package mighta screwed up
> the spacing
> EB> and stuff pasting it into this message.
> EB> {-----------------------------Cut
> Here----------------------------}
>
> Could you please repost both parts, as I missed the first one
> and
> your second one was pretty messed up by the time it got here. Tnx...
>
>
>
Ok, here goes!
---------------------Cut here - SERIAL.PAS---------------------------*)
program Serial(input, output);
const
HexDigits: array[0..15] of char = '0123456789ABCDEF';
type
InfoBuffer = record
InfoLevel : word; {should be zero}
Serial : longint;
VolLabel : array[0..10] of Char;
FileSystem : array[0..7] of Char;
end;
SerString = String[9];
var
IB : InfoBuffer;
N : word;
let : char;
param : string[10];
IsSet : boolean;
NewSerial : longint;
code : integer;
function SerialStr(L : longint) : SerString;
var Temp : SerString;
begin
Temp[0] := #9;
Temp[1] := HexDigits[L shr 28];
Temp[2] := HexDigits[(L shr 24) and $F];
Temp[3] := HexDigits[(L shr 20) and $F];
Temp[4] := HexDigits[(L shr 16) and $F];
Temp[5] := '-';
Temp[6] := HexDigits[(L shr 12) and $F];
Temp[7] := HexDigits[(L shr 8) and $F];
Temp[8] := HexDigits[(L shr 4) and $F];
Temp[9] := HexDigits[L and $F];
SerialStr :=Temp;
end;
function GetSerial(DiskNum : byte;
var I : InfoBuffer) : word; assembler;
asm
MOV AH, 69h
MOV AL, 00h
MOV BL, DiskNum
PUSH DS
LDS DX, I
INT 21h
POP DS
JC @Bad
XOR AX, AX
@Bad:
end;
function SetSerial(DiskNum : byte;
var I : InfoBuffer) : word; Assembler;
asm
MOV AH, 69h
MOV AL, 00h
MOV BL, DiskNum
PUSH DS
LDS DX, I
INT 21h
POP DS
JC @Bad
XOR AX, AX
@Bad:
end;
procedure ErrorOut(err : Byte);
begin
case err of
5 : begin
writeln('Either the disk in ',let,': is
write-',
'protected or it lacks an
extended BPB.');
writeln('If the disk is not
write-protected, ',
'reformat it with DOS 4 or
higher.');
end;
15 : writeln('Not a valid drive letter.');
255 : begin
writeln('SYNTAX: SERIAL D:
########"');
writeln(' where D: is the drive letter
',
'and ######## is the eight
digit');
writeln(' hexadecimal serial number
with-',
'out the "-".');
writeln('EXAMPLE: SERIAL A: 1234ABCD');
end;
else writeln('DOS ERROR #',N);
end;
halt(1);
end;
begin
if ParamCount < 1 then ErrorOut(255);
if ParamCount > 2 then ErrorOut(255);
Param := ParamStr(1);
case length(Param) of
1 : {OK};
2 : if Param[2] <> ':' then ErrorOut(255);
else ErrorOut(255);
end;
let := upcase(Param[1]);
if (let < 'A') or (let > 'Z') Then ErrorOut(15);
if ParamCount < 2 then IsSet := false
else
begin
IsSet := true;
Param:= '$'+ParamStr(2);
Val(Param, NewSerial, Code);
if Code <> 0 then ErrorOut(255);
end;
N := GetSerial(ord(Let)-ord('@'), IB);
if N = 0 then
begin
with IB do
begin
writeln('Serial Number is "',
SerialStr(Serial), '"');
if IsSet then
begin
Serial :=
NewSerial;;
N :=
SetSerial(ord(Let)-ord('@'), IB);
if N = 0 then
writeln('Successfully canged serial to "',
Seri
alStr(NewSerial),'"')
else
ErrorOut(N);
end;
end;
end
else ErrorOut(N);
end.